home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Over 1,000 Windows 95 Programs
/
Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso
/
1471
/
frmmain.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1997-02-11
|
15KB
|
472 lines
VERSION 4.00
Begin VB.Form frmMain
Caption = "ThreadView Sample Application"
ClientHeight = 5784
ClientLeft = 3612
ClientTop = 1896
ClientWidth = 6552
Height = 6168
Left = 3564
LinkTopic = "Form1"
ScaleHeight = 5784
ScaleWidth = 6552
Top = 1560
Width = 6648
Begin VB.PictureBox picCmdCenter
Height = 828
Left = 96
ScaleHeight = 780
ScaleWidth = 6300
TabIndex = 4
Top = 2940
Visible = 0 'False
Width = 6348
Begin VB.TextBox txtSelect
Height = 288
Left = 4128
TabIndex = 14
Text = "1"
Top = 60
Width = 588
End
Begin VB.TextBox txtDeselect
Height = 288
Left = 4128
TabIndex = 13
Text = "1"
Top = 420
Width = 588
End
Begin VB.CommandButton cmdDeselect
Caption = "Deselect"
Height = 312
Left = 4824
TabIndex = 12
Top = 408
Width = 1152
End
Begin VB.CommandButton cmdCollapseAll
Caption = "Collapse All"
Height = 312
Left = 2340
TabIndex = 11
Top = 420
Width = 1152
End
Begin VB.CommandButton cmdExpandAll
Caption = "Expand All"
Height = 312
Left = 2328
TabIndex = 10
Top = 72
Width = 1152
End
Begin VB.CommandButton cmdSelect
Caption = "Select"
Height = 312
Left = 4824
TabIndex = 9
Top = 48
Width = 1152
End
Begin VB.TextBox txtCollapse
Height = 288
Left = 48
TabIndex = 8
Text = "1"
Top = 420
Width = 588
End
Begin VB.CommandButton cmdCollapse
Caption = "Collapse"
Height = 312
Left = 732
TabIndex = 7
Top = 408
Width = 1152
End
Begin VB.TextBox txtExpand
Height = 288
Left = 48
TabIndex = 6
Text = "1"
Top = 72
Width = 588
End
Begin VB.CommandButton cmdExpand
Caption = "Expand"
Height = 312
Left = 732
TabIndex = 5
Top = 60
Width = 1152
End
End
Begin VB.TextBox Text1
Height = 1392
Left = 540
Locked = -1 'True
MultiLine = -1 'True
TabIndex = 3
Top = 3756
Visible = 0 'False
Width = 5748
End
Begin VB.PictureBox picHeader
Appearance = 0 'Flat
AutoSize = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 444
Left = 390
Picture = "frmMain.frx":0000
ScaleHeight = 444
ScaleWidth = 4620
TabIndex = 0
TabStop = 0 'False
Top = 30
Width = 4620
End
Begin ThreadViewAX.ThreadView ThreadView1
Height = 1248
Left = 1116
TabIndex = 15
Top = 1188
Width = 4464
_ExtentX = 7874
_ExtentY = 2201
BorderStyle = 1
ColumnCount = 0
End
Begin ComctlLib.ImageList ImageList1
Left = 2796
Top = 2652
_Version = 65536
_ExtentX = 804
_ExtentY = 804
_StockProps = 1
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 128
NumImages = 7
i1 = "frmMain.frx":3C56
i2 = "frmMain.frx":3E11
i3 = "frmMain.frx":3FCC
i4 = "frmMain.frx":4187
i5 = "frmMain.frx":433E
i6 = "frmMain.frx":44F9
i7 = "frmMain.frx":46B4
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 300
Left = 0
TabIndex = 2
Top = 5484
Width = 6552
_Version = 65536
_ExtentX = 11557
_ExtentY = 529
_StockProps = 68
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 7.8
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
AlignSet = -1 'True
SimpleText = ""
i1 = "frmMain.frx":4BAF
End
Begin ComctlLib.TabStrip TabStrip1
Height = 4776
Left = 48
TabIndex = 1
Top = 588
Width = 6468
_Version = 65536
_ExtentX = 11409
_ExtentY = 8424
_StockProps = 68
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 7.8
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ImageList = ""
NumTabs = 3
i1 = "frmMain.frx":4CBB
i2 = "frmMain.frx":4E02
i3 = "frmMain.frx":4F4D
End
Begin VB.Menu mnuPopup
Caption = "PopUp"
Visible = 0 'False
Begin VB.Menu mnuExpand
Caption = "Expand"
End
Begin VB.Menu mnuCollapse
Caption = "Collapse"
End
End
Begin VB.Menu mnuHeader
Caption = "HeaderPopUp"
Visible = 0 'False
Begin VB.Menu mnuSortAsc
Caption = "Sort Ascending"
End
Begin VB.Menu mnuSortDesc
Caption = "Sort Descending"
End
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim FileSys As clscFileSysItems
Dim Contacts As clscContacts
Dim Messages As clscMessages
Dim pnlMsg As Panel
Dim lngCurSect As Long
'This sub reads data from Access database and
'loads it into ThreadView control
Private Sub DiscussionsTree()
With ThreadView1
.Frozen = True 'Always use frozen!
'You can also add or remove columns at design-time
'using property page
With .Columns
.Clear
.Add "Subject", "Subject", 200, vbLeftJustify
.Add "Sender", "Author", 80, vbLeftJustify
.Add "DateSent", "Date", 80, vbRightJustify
End With
.SortColumn = 1
Set .ImageList = ImageList1
'if object with data isn't initialized, do it now
If Messages Is Nothing Then
MousePointer = vbHourglass
pnlMsg = "Loading Jet and retrieving data ..."
DoEvents 'give status bar time to repaint itself
Set Messages = New clscMessages
Messages.Create
End If
Set .UserObject = Messages
.Frozen = False
MousePointer = vbDefault
pnlMsg = "Ready"
End With
Text1.Visible = True
picCmdCenter.Visible = False
End Sub
'This sub reads your drive information and
'loads it into ThreadView control
Private Sub FileSysTree()
'Hides/shows controls
Text1.Visible = False
picCmdCenter.Visible = False
With ThreadView1
.Frozen = True 'Always use frozen!
'You can also add or remove columns at design-time
'using property page
With .Columns
.Clear
.Add "Name", "Folder/File Name", 200, vbLeftJustify
.Add "Size", "Size In Bytes", 80, vbRightJustify
.Add "DateModified", "Date Of Last Modification", 80, vbRightJustify
End With
.SortColumn = 1
Set .ImageList = ImageList1
'if object with data isn't initialized, do it now
If FileSys Is Nothing Then
MousePointer = vbHourglass
pnlMsg = "Reading your drive information..."
DoEvents 'give status bar time to repaint itself
Set FileSys = New clscFileSysItems
FileSys.Create "c:\"
End If
Set .UserObject = FileSys
.Frozen = False
End With
MousePointer = vbDefault
pnlMsg = "Ready"
End Sub
'This sub reads data from Access database and
'loads it into ThreadView control
Private Sub ContactsTree()
Text1.Visible = False
picCmdCenter.Visible = True
With ThreadView1
.Frozen = True 'Always use frozen
'You can also add or remove columns at design-time
'using property page
With .Columns
.Clear
.Add "Name", "Contact Name", 200, vbLeftJustify
.Add "WorkPhone", "Work Phone", 80, vbRightJustify
.Add "LastMeetingDate", "Last Meeting Date", 80, vbRightJustify
End With
.SortColumn = 1
Set .ImageList = ImageList1
'if object with data isn't initialized, do it now
If Contacts Is Nothing Then
MousePointer = vbHourglass
pnlMsg = "Loading Jet and retrieving data ..."
DoEvents 'give status bar time to repaint itself
Set Contacts = New clscContacts
Contacts.Create
End If
Set .UserObject = Contacts
.Frozen = False
End With
MousePointer = vbDefault
pnlMsg = "Ready"
End Sub
Private Sub cmdCollapse_Click()
ThreadView1.ThreadLines(txtCollapse).Expanded = False
End Sub
Private Sub cmdCollapseAll_Click()
Dim i As Long
ThreadView1.Frozen = True
i = i + 1
ThreadView1.ThreadLines(i).Expanded = False
Loop While ThreadView1.ThreadLines.Count > i
ThreadView1.Frozen = False
End Sub
Private Sub cmdExpand_Click()
ThreadView1.ThreadLines(txtExpand).Expanded = True
End Sub
Private Sub cmdExpandAll_Click()
Dim i As Long
ThreadView1.Frozen = True
i = i + 1
ThreadView1.ThreadLines(i).Expanded = True
Loop While ThreadView1.ThreadLines.Count > i
ThreadView1.Frozen = False
End Sub
Private Sub cmdSelect_Click()
ThreadView1.ThreadLines(txtSelect).Selected = True
End Sub
Private Sub cmdDeselect_Click()
ThreadView1.ThreadLines(txtDeselect).Selected = False
End Sub
Private Sub Form_Load()
Set pnlMsg = statusbar1.Panels(1)
FileSysTree
End Sub
Private Sub Form_Resize()
If WindowState = vbMinimized Then Exit Sub
With TabStrip1
.Width = ScaleWidth - 100
.Height = ScaleHeight - 1000
End With
With Text1
If .Visible Then
.Left = TabStrip1.ClientLeft
.Width = TabStrip1.ClientWidth
.Top = TabStrip1.ClientTop + TabStrip1.ClientHeight / 2
.Height = TabStrip1.ClientHeight / 2
End If
End With
With picCmdCenter
If .Visible Then
.Top = TabStrip1.ClientTop + TabStrip1.ClientHeight - .Height
.Width = TabStrip1.ClientWidth
End If
End With
With ThreadView1
'Always set Frozen to True before making a number of changes
.Frozen = True
.Left = TabStrip1.ClientLeft
.Top = TabStrip1.ClientTop
.Width = TabStrip1.ClientWidth
Select Case TabStrip1.SelectedItem.Key
Case "Contacts" 'Contacts
.Height = TabStrip1.ClientHeight - picCmdCenter.Height
Case "Discussions" 'Discussions
.Height = TabStrip1.ClientHeight / 2
Case Else
.Height = TabStrip1.ClientHeight
End Select
.Frozen = False
End With
picHeader.Left = (ScaleWidth - picHeader.Width) / 2
End Sub
Private Sub mnuCollapse_Click()
ThreadView1.SelectedItem.Expanded = False
End Sub
Private Sub mnuExpand_Click()
ThreadView1.SelectedItem.Expanded = True
End Sub
Private Sub mnuSortAsc_Click()
ThreadView1.SortColumn = lngCurSect
ThreadView1.SortOrder = thvSortAsc
End Sub
Private Sub mnuSortDesc_Click()
ThreadView1.SortColumn = lngCurSect
ThreadView1.SortOrder = thvSortDesc
End Sub
Private Sub TabStrip1_Click()
Select Case TabStrip1.SelectedItem.Key
Case "FileSys": FileSysTree
Case "Contacts": ContactsTree
Case "Discussions": DiscussionsTree
End Select
Form_Resize
End Sub
Private Sub ThreadView1_Collapse(Line As ThreadLine)
'You can use this event to unload child objects:
'Set Line.object.Children = Nothing
'Keep your memory tidy!
End Sub
Private Sub ThreadView1_HeaderClick(Column As ThreadViewAX.Column)
With ThreadView1
If .SortColumn = Column.Index Then
.SortOrder = Abs(Not CBool(.SortOrder))
Else
.SortColumn = Column.Index
End If
End With
End Sub
Private Sub ThreadView1_HeaderMouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer, lngWidth As Long
If (Button And vbRightButton) = vbRightButton Then
'determines which column header was pressed
For i = 1 To ThreadView1.Columns.Count
lngWidth = lngWidth + ThreadView1.Columns(i).Width
If lngWidth >= X Then
lngCurSect = i
Exit For
End If
Next i
PopupMenu mnuHeader, vbPopupMenuRightButton
End If
End Sub
Private Sub ThreadView1_ItemClick(Line As ThreadLine)
If TabStrip1.SelectedItem.Key = "Discussions" Then
Text1 = Line.object.Message
End If
End Sub
Private Sub ThreadView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And vbRightButton Then
If ThreadView1.SelectedItem.object.HasChildren Then
mnuExpand.Enabled = Not ThreadView1.SelectedItem.Expanded
mnuCollapse.Enabled = ThreadView1.SelectedItem.Expanded
Else
mnuExpand.Enabled = False
mnuCollapse.Enabled = False
End If
PopupMenu mnuPopup
End If
End Sub